home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
hp48.cc
< prev
next >
Wrap
Text File
|
1991-01-29
|
10KB
|
414 lines
017B0 Error Beep suppressed?
017B7 frequency = 0?
02919 push A (System Binary)
0291C ...
0291F continue RPL
02A5C continue RPL
02D59 save C (popped by RTNNC)
02D88 return if space available
02DA5 put rtn ptr in D0 ...
02DA7 and D0 (PC) in C
02DAA push PC onto rtn stack ...
02DAD ...
02DB0 set B (rtn ptr) ...
02DB3 ...
02DB5 inc new PC past 02D9D
02DB8 get next routine
02DBB inc PC
02DBE call next rpl routine
02E75 push A (addr of 02E6D = addr of local name)
02E78 ...
02E7B goto RPL pgm @ 02FD6
02F15 push A
02F1B goto RPL pgm @ 02fd6
03019 flag first time through
0301C save D1 on RSTK ...
0301F ...
03021 save B on RSTK ...
03023 ...
03029 second time?
0302A read next object
0302E get next object
03031 skip next object
03037 get type of RPL Routine
03041 not RPL Obj Type?
03046 Literal RPL Object in code - Skip Past
03066 restore B
0306A restore D1
03130 Get Return SP into D0
03132 ...
03135 pop rtn stk into A ...
03138 ...
0313B set D0 to new PC
0313E set B (rtn ptr)
03142 get next routine
03145 inc PC
03148 call next RPL routine
03164 Let C.A = (DEPTH+1) * 5
03185 BET
0318D room on stack?
0318F if not, make some
03192 get obj @ TOS
03195 push object again
0319B continue RPL
031A9 BET
031D6 BET
03228 pop TOS -> C
0322E copy TOS-1 -> A
03231 replace TOS-1 with TOS
03234 push TOS-1
0323A continue RPL
03249 pop stack
0324C more stack space avail
0324E continue RPL
0325D pop two objects from the stack
03260 more stack space avail
03262 ...
03264 continue RPL
032BF BET
03416 need 1 stack element
03435 alloc C elements if room
03437 was room so ok
0343A out of memory!
03585 continue RPL
03678 push A on stack
0367B continue RPL
03A86 stack space avail?
03A88 no, make some
03A8B push A.A
03A8E ...
03A91 continue RPL
03A9B save A
03AB0 restore A
03AB3 stack space avail?
03AB5 yes, continue
03AB8 no memory avail!
03AC5 stack space avail?
03AC7 nope, make some
03ACA push A (which is 3AC0)
03AD0 continue RPL
03AEF BET
03B43 BET
03D53 put TOS -> D1 ...
03D56 save D1 in A
03D59 skip obj prolog
03D5C get obj val ?
03D5F restore D1
03D62 pop stack
03D67 save obj val
03D69 get TOS -> D1 ...
03D6C save D1 in C
03D6F skip prolog
03D72 get obj val -> A
03D75 restore D1
03D78 restore C
03F5D get obj @ TOS in D1 ...
03F60 and save D1 in A
03F63 skip obj prolog
03F66 get obj value (expect System Binary)
03F69 restore D1
03F6C pop stack
03F71 save <System Binary> on RSTK
03F73 get obj @ TOS in D1 ...
03F76 and save D1 in C
03F79 skip obj prolog
03F7C get obj val (expect System Binary)
03F7F restore D1
03F82 pop stack
03F85 inc free space
03F87 restore <System Binary>
05023 save D0 (PC)
0533C save TOS
05352 need #A nibbles
053A4 save D1 on RSTK ...
053A7 ...
053B7 unable to alloc?
054BD pop stack -> A,R1,D0
054C9 ...
054CB skip obj prolog
054D0 save 0 on RSTK
0554C already GC?
055D2 BET
055E4 len of string+len
05633 BET
056C7 copy System Binary val to c
056C9 copy System Binary val to d
056CB get obj ptr @ TOS into D0 ...
056CE ...
056D1 skip obj prolog (assume composite object, i.e. list)
056DB B=#0312B
056DF go if D was == 0
056E2 get addr from composite object
056EC go if D was == 0
05A08 pop stack -> A
05A0B ...
05A0E inc free space
05A16 put obj ptr in D1
05A19 skip obj prolog
05A1C get obj size
05A1F skip obj size
05A29 sub size fld from obj size
05A2D obj size >= 5?
05A32 obj size at least 1?
05A34 nope, push <0h>
05A37 put (obj val size)-1 in P ...
05A3A ...
05A3E since obj val size < 5, 0 rest of A
05A40 get obj val into A
05D29 BET
05DB9 BET
05F21 stack space avail?
05F23 return if so
05F26 no memory free!
06537 flag first try for memory
0653A check if A in ROM System Binary Table
06544 is A < #2C?
06555 need 15 nibbles
0656B compute free space b/w RPL RSTK & Data Stk
0656D test room for D nibbles
0656F not enough room?
06579 Create System Binary from R0
06593 push obj ptr in A
0659B second try?
065A4 flag second try for memory
065B4 let A.A = 10*A.A
065C5 compute table index
065CB check avail space
065CD go if space avail
06641 get ptr to Object @ TOS
06647 Skip Object Prolog
0664A grab System Binary value
0664D restore SP
06650 pop System Binary
0679B save D0 (i.e. RPL PC)
067AF save d1 in 70579 ...
067B2 ...
067B5 ...
067BF save B in 70574 ...
067C1 ...
067CB save D in 7066E ...
067CD ...
0680D Let C = TOS Ptr
06817 Let A = RPL RSTK Ptr
0681A Let C = Free Space B/W RSTK & TOS
06B15 alloc B.A Nibbles ...
06B18 ...
06B1A ...
06E9C get next object
06E9F save D0 (RPL PC) on RSTK ...
06EA2 and put command in D0
06EA4 get object type
06EB1 is obj not type marker?
06ECE push to the stack ...
06ED1 ...
06ED4 continue RPL
06F1B BET
06FD6 get next object
06FD9 put in D0 and save D0 in A
06FDC get object's prolog
06FE6 restore D0
06FE9 not RPL Object Literal?
06FEE Let A = D0 ...
06FF1 ...
06FF4 if A=C (was RPL Object Literal)
06FF7 get next object
06FFA save continue pt in B ...
06FFC put RPL RSTK PTR in D0
06FFF pop RPL RSTK
07002 get previous rtn addr
07005 put in PC
07008 restore B; put orig A.A in C
0700A inc free space (popped rtn stk)
0700C use orig A.A as RPL cont
0723F continue RPL
072E7 point to current loop counter
07402 save start loop value into R2
0740B save end loop value into R3
07DA9 d0 = local var ptr ...
07DAC ...
07DAF a = addr first local var
07DB2 no local vars?
08DF8 BET
1401A save D0 in C / Let D0 = 706FF
1401F set Last Err# to 0
14022 restore D0 (PC)
1402F Let @70600 = 0
14032 restore D0 (PC)
16812 let C = 10*C
18852 Save D0
18863 Store <0h> at 7065A
18866 Restore D0
18A27 save D1 (SP)
18A31 Let A = Bottom/Start of Stack
18A34 Let A = (DEPTH+1) * 5
18A4A Set 706FD.1 = 0
18A4E restore D1
18AC1 set c.s = 1
18AC9 get obj(s) on TOS (depends on P)
18ACD save obj ptr(s) in R0
18AD0 save D1 (SP) on RSTK ...
18AD3 ...
18ADC get BOS ptr into A
18ADF get size of stack * 5 in A
18AE1 set P to (#obj)*5
18AE5 P=0; C.0 = 5 or 0xA
18AF0 not enough on stack?
18AF5 compute (DEPTH-args)*5
18AF7 save (DEPTH-args)*5
18B12 restore obj ptrs
18B15 save obj ptrs
18B2A save # args in 705ba???
18B2E restore D1 ...
18B30 ...
18B35 (7069f) = stack size * 5
18B3F set nibble @ 706fd to 0 ...
18B42 ...
18B46 restore D1 (SP) ...
18B48 ...
18C77 save D0 in A
18C7D compute Current Command value
18C8A store command
18C8D restore D0
18CE3 force positive
18CF8 is it positive?
18CFD otherwise 0
18D03 set A.A to largest System Binary ...
18D05 ...
18D11 continue RPL
18D1B handle 0
18FBA save D0 on RSTK ...
18FBD ...
18FC0 ...
18FC5 save D1 on RSTK ...
18FC8 ...
18FCA ...
18FCD get next object
18FD7 at end of RPL Pgm?
18FE3 not System Binary literal?
18FE8 skip prolog (02911)
18FEB get value in C
18FEE No Carry is True
18FF1 save D0 in A and
18FF4 skip obj prolog
18FF7 get obj value (expect System Binary?)
18FFA restore D0
18FFD skip over object
19009 flag C.0 < F
19012 flag C.0 was F
19017 save C on RSTK
19019 Let C.A,A.A = C.P ...
1901B ...
1901E ...
19020 Let A.A = 5 * A.A ...
19022 ...
19024 ...
19026 was C.0 == F?
1908B goto RPL
1A560 pop -> C
1A566 inc free space
1A568 save D1 in C; Let D1=obj ptr
1A56B skip obj prolog
1A56E get obj val (expect System Binary)
1A571 restore D1
1C6EE continue RPL
29FDA get obj ptr @ TOS into D1 ...
29FDD and save D1 in C
29FE0 skip obj prolog
29FE3 get obj val (expect Real)
29FE7 restore D1
29FEA pop stack
29FED inc free space
2A195 save A
2A198 restore A (ENTRY POINT)
2A1CF save D0 in A ...
2A1D2 ...
2A1DC construct real @ D0 with value of R0
2A1EF push new Real
2A735 BET
2A768 BET
2A785 BET
2A796 BET
2A79E put TOS -> D1 ...
2A7A1 save D1 in C
2A7A4 skip prolog
2A7A7 get obj val -> A (expect Real?)
2A7AB restore D1
2A7AE negative?
2A7B3 zero?
2A7B8 BET
2A867 continue RPL
2A87C BET
2A8ED BET
2A94C BET
2A958 BET
2A9A3 BET
2AA9B BET
2AAF3 BET
4452C BET
51A38 XFER: contine RPL
5375A signal use User Flags
53766 signal use System Flags
53F8D set up stack as popped
53F99 get obj @ TOS in D1 ...
53F9C ...
53F9F skip obj prolog
53FA2 get obj val (expect System Binary)
53FB0 Let D = <System Binary> - 5 - 1
53FB2 pop stack
53FBE Let C = C >> 2
53FC1 and Set SB if (C & 3) != 0
53FC4 Now C.B = (C.B / 4) - 1
53FCF save C
53FD9 restore C
5422C save A ???
5422F clear tried GC flag
54238 save C ???
5427B save A.A
5428C restore A.A
54407 if positive, ok
5EDBE C = s1
5EDC1 C = d1, D1 = s1
5EDC4 A = prolog of s1
5EDC7 Restore D1
61219 BET
618DF unpop one System Binary
61907 pop stack
61930 BET
61954 TOS was == FALSE?
61957 pop stack
6195A inc free space
619B9 BET
619C8 BET
61A02 pop stack -> A ...
61A05 ...
61A08 inc free stack space
61A11 set carry if was True
61A38 BET
61ADD Let C = D0 ...
61AE0 ...
61AE3 and save D0 on RSTK
61B09 save D0 on RSTK
61B0E ...
61B28 get object of interest
61B2E get object type in A
61B42 BET
6205B save C (obj prolog to test for)
6205D get TOS -> D1 ...
62060 save D1 in C
62063 get obj prolog
62066 restore D1
62069 restore C
6206B obj has right type?
62080 replace TOS w/True
620A0 replace TOS w/False
620CC execute True
620CE which pushes 03A81 as obj ptr
620E5 execute False
620E7 which pushes 03AC0 as obj ptr
62100 BET
628AC set Carry if C>A
717E7 expect (D0) to be LSTR
717E9 get LSTR len
717EC skip past len
71811 len * 2 = # nibbles